Option Explicit
Dim Dates(1000) As Date
Dim Weights(1000) As String
Dim NumWts As Integer
----------------------------
Sub Init()
NumWts = 1:  vsbControl.Value = 1: vsbControl.Max = 1
Dates(1) = Format(Now, "mm/dd/yy")
Weights(1) = ""
lblDate.Caption = Dates(1)
txtWeight.Text = Weights(1)
lblFile.Caption = "New File"
End Sub
--------------------------------------------
Private Sub Form_Load()
Dim I As Integer
'Open .ini file and load in recent file names
'If error, file isn't there so create empty file
On Error GoTo HandleErrors
Open App.Path + "\weight.ini" For Input As #1
Close 1
frmWeight.Show
Call Init
Exit Sub
---------------------------------
Private Sub mnuFileOpen_Click()
Dim I As Integer
Dim Today As Date
Dim Response As Integer
Dim File_To_Open As String
Response = MsgBox("Are you sure you want to open a new file?", vbYesNo + vbQuestion, "New File")
If Response = vbNo Then Exit Sub
If MenuOpen = 0 Then
  cdlFiles.Filter = "Files (*.wgt)|*.wgt"
  cdlFiles.DefaultExt = "wgt"
  cdlFiles.DialogTitle = "Open File"
  cdlFiles.Flags = cdlOFNFileMustExist + cdlOFNPathMustExist
  On Error GoTo No_Open
  cdlFiles.ShowOpen
  File_To_Open = cdlFiles.FileName
Else
  File_To_Open = FNmenu
End If
MenuOpen = 0
On Error GoTo BadOpen
Open File_To_Open For Input As #1
lblFile.Caption = File_To_Open
Input #1, NumWts
For I = 1 To NumWts
  Input #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(File_To_Open)
Today = Format(Now, "mm/dd/yy")
If Today <> Dates(NumWts) Then
  NumWts = NumWts + 1
  Dates(NumWts) = Today
  Weights(NumWts) = ""
End If
vsbControl.Max = NumWts
vsbControl.Value = NumWts
lblDate.Caption = Dates(NumWts)
txtWeight.Text = Weights(NumWts)
Exit Sub
No_Open:
Resume ExitLine
ExitLine:
Exit Sub
BadOpen:
Select Case MsgBox(Error$(Err.Number), vbCritical + vbRetryCancel, "File Open Error")
Case vbRetry
  Resume
Case vbCancel
  Resume No_Open
End Select
End Sub
---------------------------------------
Private Sub mnuFilePlot_Click()
Dim X(100) As Integer, Y(100) As Integer
Dim I As Integer
Dim Xmin As Integer, Xmax As Integer
Dim Ymin As Integer, Ymax As Integer
Dim Legend As String
Xmin = 0: Xmax = 0
Ymin = Val(Weights(1)): Ymax = Ymin
For I = 1 To NumWts
  X(I) = DateDiff("d", Dates(1), Dates(I))
  Y(I) = Val(Weights(I))
  If X(I) < Xmin Then Xmin = X(I)
  If X(I) > Xmax Then Xmax = X(I)
  If Y(I) < Ymin Then Ymin = Y(I)
  If Y(I) > Ymax Then Ymax = Y(I)
Next I
Xmin = Xmin - 1: Xmax = Xmax + 1
Ymin = (1 - 0.05 * Sgn(Ymin)) * Ymin
Ymax = (1 + 0.05 * Sgn(Ymax)) * Ymax
picPlot.Scale (Xmin, Ymax)-(Xmax, Ymin)
Cls
picPlot.Cls
For I = 1 To NumWts
  picPlot.Line (X(I), Ymin)-(X(I), Y(I)), QBColor(1)
Next I
Legend = Str(Ymax)
CurrentX = picPlot.Left - TextWidth(Legend)
CurrentY = picPlot.Top - 0.5 * TextHeight(Legend)
Print Legend
Legend = Str(Ymin)
CurrentX = picPlot.Left - TextWidth(Legend)
CurrentY = picPlot.Top + picPlot.Height - 0.5 * TextHeight(Legend)
Print Legend
End Sub

Private Sub mnuFileRecent_Click(Index As Integer)
  FNmenu = RFile(Index): MenuOpen = 1
  Call mnuFileOpen_Click
End Sub

Private Sub mnuFileSave_Click()
Dim I As Integer
cdlFiles.Filter = "Files (*.wgt)|*.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Save File"
cdlFiles.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist
On Error GoTo No_Save
cdlFiles.ShowSave
Open cdlFiles.FileName For Output As #1
lblFile.Caption = cdlFiles.FileName
Write #1, NumWts
For I = 1 To NumWts
  Write #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(cdlFiles.FileName)
Exit Sub
No_Save:
Resume ExitLine
ExitLine:
Exit Sub
End Sub
------------------------------------------

Private Sub txtWeight_Change()
Weights(vsbControl.Value) = txtWeight.Text
End Sub


Private Sub txtWeight_KeyPress(KeyAscii As Integer)
If KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Then
  Exit Sub
Else
  KeyAscii = 0
End If
End Sub


Private Sub vsbControl_Change()
lblDate.Caption = Dates(vsbControl.Value)
txtWeight.Text = Weights(vsbControl.Value)
txtWeight.SetFocus
End Sub


